home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / crystal-logo.scm < prev    next >
Text File  |  2009-12-15  |  8KB  |  228 lines
  1. ;  CRYSTAL
  2. ;  Create a text effect that simulates crystal
  3.  
  4. (define (script-fu-crystal-logo chrome-factor text size font bg-img env-map)
  5.  
  6.   (define (set-pt a index x y)
  7.     (begin
  8.       (aset a (* index 2) x)
  9.       (aset a (+ (* index 2) 1) y)
  10.     )
  11.   )
  12.  
  13.   (define (spline1)
  14.     (let* ((a (cons-array 18 'byte)))
  15.       (set-pt a 0 0 0)
  16.       (set-pt a 1 31 235)
  17.       (set-pt a 2 63 23)
  18.       (set-pt a 3 95 230)
  19.       (set-pt a 4 127 25)
  20.       (set-pt a 5 159 210)
  21.       (set-pt a 6 191 20)
  22.       (set-pt a 7 223 240)
  23.       (set-pt a 8 255 31)
  24.       a
  25.     )
  26.   )
  27.  
  28.   (define (crystal-brush brush-size)
  29.     (cond ((<= brush-size 5) "Circle (05)")
  30.           ((<= brush-size 7) "Circle (07)")
  31.           ((<= brush-size 9) "Circle (09)")
  32.           ((<= brush-size 11) "Circle (11)")
  33.           ((<= brush-size 13) "Circle (13)")
  34.           ((<= brush-size 15) "Circle (15)")
  35.           ((<= brush-size 17) "Circle (17)")
  36.           ((>  brush-size 17) "Circle Fuzzy (19)")
  37.     )
  38.   )
  39.  
  40.   (define (shadows val)
  41.     (/ (* 0.96 val) 2.55)
  42.   )
  43.  
  44.   (define (midtones val)
  45.     (/ val 2.55)
  46.   )
  47.  
  48.   (define (highlights val)
  49.     (/ (* 1.108 val) 2.55)
  50.   )
  51.  
  52.   (define (rval col)
  53.     (car col)
  54.   )
  55.  
  56.   (define (gval col)
  57.     (cadr col)
  58.   )
  59.  
  60.   (define (bval col)
  61.     (caddr col)
  62.   )
  63.  
  64.   (define (sota-scale val scale chrome-factor)
  65.     (* (sqrt val) (* scale chrome-factor))
  66.   )
  67.  
  68.   (define (copy-layer-crystal dest-image dest-drawable source-image source-drawable)
  69.     (gimp-selection-all dest-image)
  70.     (gimp-edit-clear dest-drawable)
  71.     (gimp-selection-none dest-image)
  72.     (gimp-selection-all source-image)
  73.     (gimp-edit-copy source-drawable)
  74.     (let ((floating-sel (car (gimp-edit-paste dest-drawable FALSE))))
  75.       (gimp-floating-sel-anchor floating-sel)
  76.     )
  77.   )
  78.  
  79.   (let* (
  80.         (img (car (gimp-image-new 256 256 GRAY)))
  81.         (back-img (car (gimp-file-load 1 bg-img bg-img)))
  82.         (back-layer (car (gimp-image-get-active-drawable back-img)))
  83.         (banding-img (car (gimp-file-load 1 env-map env-map)))
  84.         (banding-layer (car (gimp-image-get-active-drawable banding-img)))
  85.         (banding-height (car (gimp-drawable-height banding-layer)))
  86.         (banding-width (car (gimp-drawable-width banding-layer)))
  87.         (banding-type (car (gimp-drawable-type banding-layer)))
  88.         (b-size (sota-scale size 2 chrome-factor))
  89.         (offx1 (sota-scale size 0.33 chrome-factor))
  90.         (offy1 (sota-scale size 0.25 chrome-factor))
  91.         (offx2 (sota-scale size (- 0.33) chrome-factor))
  92.         (offy2 (sota-scale size (- 0.25) chrome-factor))
  93.         (feather (sota-scale size 0.5 chrome-factor))
  94.         (blur (sota-scale size 0.5 chrome-factor))
  95.         (displace (sota-scale size 0.25 chrome-factor))
  96.         (brush-size (sota-scale size 0.5 chrome-factor))
  97.         (text-layer (car (gimp-text-fontname img -1 0 0 text b-size TRUE size PIXELS font)))
  98.         (width (car (gimp-drawable-width text-layer)))
  99.         (height (car (gimp-drawable-height text-layer)))
  100.         (tile-ret (plug-in-tile RUN-NONINTERACTIVE back-img back-layer width height TRUE))
  101.         (tile-img (car tile-ret))
  102.         (tile-layer (cadr tile-ret))
  103.         (tile-width (car (gimp-drawable-width tile-layer)))
  104.         (tile-height (car (gimp-drawable-height tile-layer)))
  105.         (tile-type (car (gimp-drawable-type tile-layer)))
  106.         (bg-layer (car (gimp-layer-new img tile-width tile-height tile-type "BG-Layer" 100 NORMAL-MODE)))
  107.         (layer1 (car (gimp-layer-new img banding-width banding-height banding-type "Layer1" 100 NORMAL-MODE)))
  108.         (layer2 (car (gimp-layer-new img width height GRAYA-IMAGE "Layer 2" 100 DIFFERENCE-MODE)))
  109.         (layer3 (car (gimp-layer-new img width height GRAYA-IMAGE "Layer 3" 100 NORMAL-MODE)))
  110.         (layer-mask 0)
  111.         (layer-mask2 0)
  112.         (disp-map 0)
  113.         )
  114.     (gimp-context-push)
  115.  
  116.     (gimp-image-delete back-img)
  117.     (gimp-image-undo-disable img)
  118.     (gimp-image-resize img width height 0 0)
  119.     (gimp-image-add-layer img layer3 0)
  120.     (gimp-image-add-layer img layer2 0)
  121.     (gimp-context-set-background '(255 255 255))
  122.     (gimp-selection-none img)
  123.     (gimp-edit-fill layer2 BACKGROUND-FILL)
  124.     (gimp-edit-fill layer3 BACKGROUND-FILL)
  125.     (gimp-drawable-set-visible text-layer FALSE)
  126.  
  127.     (gimp-selection-layer-alpha text-layer)
  128.     (gimp-context-set-background '(0 0 0))
  129.     (gimp-selection-translate img offx1 offy1)
  130.     (gimp-selection-feather img feather)
  131.     (gimp-edit-fill layer2 BACKGROUND-FILL)
  132.     (gimp-selection-translate img (* 2 offx2) (* 2 offy2))
  133.     (gimp-edit-fill layer3 BACKGROUND-FILL)
  134.     (gimp-selection-none img)
  135.     (set! layer2 (car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
  136.     (gimp-invert layer2)
  137.  
  138.     (gimp-image-add-layer img layer1 0)
  139.     (copy-layer-crystal img layer1 banding-img banding-layer)
  140.     (gimp-image-delete banding-img)
  141.     (gimp-layer-scale layer1 width height FALSE)
  142.     (plug-in-gauss-iir RUN-NONINTERACTIVE img layer1 10 TRUE TRUE)
  143.     (gimp-layer-set-opacity layer1 50)
  144.     (set! layer1 (car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
  145.     (gimp-curves-spline layer1 0 18 (spline1))
  146.  
  147.     (set! layer-mask (car (gimp-layer-create-mask layer1 ADD-BLACK-MASK)))
  148.     (gimp-layer-add-mask layer1 layer-mask)
  149.     (gimp-selection-layer-alpha text-layer)
  150.     (gimp-context-set-background '(255 255 255))
  151.     (gimp-edit-fill layer-mask BACKGROUND-FILL)
  152.  
  153.     (set! disp-map (car (gimp-selection-save img)))
  154.     (gimp-context-set-brush (crystal-brush brush-size))
  155.     (gimp-context-set-foreground '(0 0 0))
  156.     (gimp-edit-stroke disp-map)
  157.     (gimp-selection-none img)
  158.  
  159.     (plug-in-gauss-rle RUN-NONINTERACTIVE img disp-map blur TRUE TRUE)
  160.     (gimp-levels disp-map 0 0 255 1.0 96 255)
  161.  
  162.     (if (= (car (gimp-drawable-is-rgb bg-layer)) 1)
  163.         (gimp-image-convert-rgb img))
  164.  
  165.  
  166.  
  167.     (gimp-image-add-layer img bg-layer 2)
  168.     (copy-layer-crystal img bg-layer tile-img tile-layer)
  169.     (gimp-image-delete tile-img)
  170.     (set! layer2 (car (gimp-layer-copy bg-layer TRUE)))
  171.     (gimp-image-add-layer img layer2 1)
  172.  
  173.     (plug-in-displace RUN-NONINTERACTIVE img layer2 displace displace TRUE TRUE disp-map disp-map 0)
  174.     (set! layer-mask2 (car (gimp-layer-create-mask layer2 ADD-BLACK-MASK)))
  175.     (gimp-layer-add-mask layer2 layer-mask2)
  176.     (gimp-selection-layer-alpha text-layer)
  177.     (gimp-context-set-background '(255 255 255))
  178.     (gimp-edit-fill layer-mask2 BACKGROUND-FILL)
  179.  
  180.     (gimp-selection-none img)
  181.     (gimp-levels layer2 0 0 200 1.5 50 255)
  182.     (gimp-layer-set-mode layer1 OVERLAY-MODE)
  183.  
  184.     (plug-in-gauss-rle RUN-NONINTERACTIVE img text-layer blur TRUE TRUE)
  185.     (gimp-layer-set-lock-alpha text-layer TRUE)
  186.     (gimp-context-set-background '(0 0 0))
  187.     (gimp-edit-fill text-layer BACKGROUND-FILL)
  188.     (gimp-layer-set-mode text-layer OVERLAY-MODE)
  189.     (gimp-layer-translate text-layer offx1 offy1)
  190.  
  191.     (gimp-image-remove-channel img disp-map)
  192.  
  193.     (gimp-drawable-set-visible text-layer TRUE)
  194.     (gimp-drawable-set-name layer1 "Crystal")
  195.     (gimp-drawable-set-name layer2 "Interior")
  196.     (gimp-drawable-set-name bg-layer "Background")
  197.     (gimp-drawable-set-name text-layer "Shadow")
  198.  
  199.     (gimp-image-undo-enable img)
  200.     (gimp-display-new img)
  201.  
  202.     (gimp-context-pop)
  203.   )
  204. )
  205.  
  206.  
  207. (script-fu-register "script-fu-crystal-logo"
  208.   _"Crystal..."
  209.   _"Create a logo with a crystal/gel effect displacing the image underneath"
  210.   "Spencer Kimball"
  211.   "Spencer Kimball"
  212.   "1997"
  213.   ""
  214.   SF-ADJUSTMENT _"Chrome factor"      '(1.0 0.2 4 0.1 1 1 0)
  215.   SF-STRING     _"Text"               "Crystal"
  216.   SF-ADJUSTMENT _"Font size (pixels)" '(150 2 1000 1 10 0 1)
  217.   SF-FONT       _"Font"               "Engraver"
  218.   SF-FILENAME   _"Background image"
  219.                  (string-append gimp-data-directory
  220.                                 "/scripts/images/texture1.jpg")
  221.   SF-FILENAME   _"Environment map"
  222.                  (string-append gimp-data-directory
  223.                                 "/scripts/images/beavis.jpg")
  224. )
  225.  
  226. (script-fu-menu-register "script-fu-crystal-logo"
  227.                          "<Image>/File/Create/Logos")
  228.